#' Extract PubMed ID
#'
#' `extract_pmid` is a generic function that extracts PubMed IDs.
#'
#' @param x An object.
#' @param ... Arguments passed on to methods.
#'
#' @returns
#' A character vector of PubMed IDs, except for the `extract_pmid.elink_list`
#' method which returns a list of PubMed ID character vectors.
#'
#' @family extract_pmid_methods
#' @export
extract_pmid <- function(x, ...) {
    UseMethod("extract_pmid")
}

#' @rdname extract_pmid
#' @export
extract_pmid.pm_search <- function(x, ...) {
    x$ids
}

#' @rdname extract_pmid
#' @export
extract_pmid.pmc_search <- function(x, ...) {
    pmids <- x$pmids

    if (length(pmids) == 0) {
        stop("No PMIDs available. Was 'pmid' set to TRUE in search_pmc()?")
    }

    pmid_missing <- is.na(pmids)
    if (any(pmid_missing)) {
        n_missing <- sum(pmid_missing)
        n_id <- length(pmids)
        pct_missing <- round(n_missing / n_id, 2)

        warning(
            n_missing, " of ", n_id, " (", pct_missing, "%)",
            " PMIDs are missing. Consider extracting PMCIDs.",
            call. = FALSE
        )
    }

    pmids
}

#' @rdname extract_pmid
#' @export
extract_pmid.data.frame <- function(x, ...) {
    df <- dplyr::rename_with(x, .fn = tolower)

    if (!"pmid" %in% names(df)) {
        stop("PMID column could not be identified. Name must be 'pmid' or 'PMID').")
    }

    pmids <- df$pmid

    pmid_missing <- is.na(pmids)
    if (any(pmid_missing)) {
        n_missing <- sum(pmid_missing)
        n_id <- length(pmids)
        pct_missing <- round(n_missing / n_id, 2)

        warning(
            n_missing, " of ", n_id, " (", pct_missing, "%)",
            " PMIDs are missing. Consider extracting alternate IDs, if available.",
            call. = FALSE
        )
    }

    pmids
}


#' Extract PubMed ID from elink object
#'
#' Extract PubMed ID from an `elink` object.
#'
#' @param x An `elink` object, generated by [rentrez::entrez_link] and it's
#' derivatives (e.g. [citedby_pmid]).
#' @param linkname linkname as specified for [Entrez API](https://eutils.ncbi.nlm.nih.gov/entrez/query/static/entrezlinks.html);
#' only necessary if more than one `linkname` is returned from PubMed.
#' @param quietly Suppress PubMed linkname message when `linkname` is not
#' specified and multiple results exist in an `elink` object.
#' @param no_result The type of condition that should be signaled when no PubMed
#'     results exist in a response; one of "error", "warning" (default),
#'     "message" or "none".
#' @param ... Unused, included for generic consistency only.
#'
#' @family extract_pmid_methods
#' @export
extract_pmid.elink <- function(x, linkname = NULL, quietly = FALSE,
                               no_result = "error", ...) {
    no_result <- match.arg(
        no_result,
        c("error", "warning", "message", "none")
    )

    nm <- names(x$links)
    pm_res <- stringr::str_detect(nm, "_pubmed")
    pm_n <- sum(pm_res)

    if (pm_n == 0) {
        msg <- "No PubMed 'cited by' results"
        switch(
            no_result,
            error = rlang::abort(msg, class = "no_result"),
            warning = rlang::warn(msg, class = "no_result"),
            message = rlang::inform(msg, class = "no_result"),
            NULL
        )
        return(invisible(NULL))
    }

    if (pm_n > 1 && is.null(linkname)) {
        stop(
            "linkname must be specified when elink object contains more than
                one pubmed result. Identified linknames: ",
            vctr_to_string(nm[pm_res], delim = ", ")
        )
    }

    pmid <- if (!is.null(linkname)) {
        x$links[[linkname]]
    } else {
        if (!quietly && length(nm) > 1) {
            message("PubMed linkname identified: ", nm[pm_res])
        }
        x$links[[pm_res]]
    }

    pmid
}


#' Extract PubMed ID from elink_list object
#'
#' Extract PubMed ID from an `elink_list` object.
#'
#' @param x An `elink_list` object, generated by [rentrez::entrez_link] and it's
#' derivatives (e.g. [citedby_pmid]) when `by_id = TRUE` .
#' @param ... Additional arguments passed on to [extract_pmid.elink()].
#' @inheritParams extract_pmid.elink
#'
#' @family extract_pmid_methods
#' @export
extract_pmid.elink_list <- function(x, no_result = "warning", ...) {
    cond_msg <- NULL
    res <- purrr::map2(
        x,
        names(x),
        function(vals, nm) {
            tryCatch(
                extract_pmid(vals, no_result = no_result, ...),
                # make no_result message more informative & discard when signaled
                no_result = function(cond) {
                    cond_type <- dplyr::nth(class(cond), -2)
                    if (cond_type == "error") {
                        rlang::abort(
                            class = class(cond)[1],
                            parent = cond
                        )
                    } else {
                        cond_msg <<- cond$message
                        return(NULL)
                    }
                }
            )
        }
    )
    names(res) <- names(x)

    # keep only those with results
    out <- purrr::compact(res)
    discard <- names(res)[!names(res) %in% names(out)]
    if (no_result != "none" & length(discard) > 0) {
        rlang::signal(
            message = c(
                paste0(cond_msg, ", discarded:"),
                purrr::set_names(discard, rep("i", length(discard)))
            ),
            class = c("no_result", no_result),
            use_cli_format = TRUE
        )
    }

    out
}


#' Extract Publication Date from PubMed Citations
#'
#' Extracts most complete publication date possible from Pubmed citations.
#'
#' This function uses a step-wise approach, attempting first to extract a full
#' date, subsequently a year & month and, if that is not available, just the
#' year. This approach is designed to prevent accidental matches to year values
#' found in titles.
#'
#' NOTE: When the day is missing, this function will return a full date using
#' the first day of the month. When both the month and day are missing, this\
#' function will return the first day of the year.
#'
#' @param citation character vector of PubMed citations
#'
#' @md
#' @export
extract_pm_date <- function(citation) {

    # define regex patterns
    ymd_regex <- "[12][0-9]{3} (Jan|Feb|Ma[ry]|Apr|Ju[nl]|Aug|Sep|Oct|Nov|Dec) [0-9]{1,2}"
    ym_regex <- "[12][0-9]{3} (Jan|Feb|Ma[ry]|Apr|Ju[nl]|Aug|Sep|Oct|Nov|Dec)"
    y_regex <- "[12][0-9]{3}"

    # stepwise identification to avoid picking up dates from titles, as much
    #   as possible
    pub_date <- dplyr::case_when(
        stringr::str_detect(citation, ymd_regex) ~
            lubridate::ymd(stringr::str_extract(citation, ymd_regex)),
        # if lacking day, will use first day of month
        stringr::str_detect(citation, ym_regex) ~
            lubridate::ym(stringr::str_extract(citation, ym_regex)),
        stringr::str_detect(citation, y_regex) ~
            # if year only, not ideal (use first day of year)
            lubridate::ymd(
                paste0(
                    stringr::str_extract(citation, y_regex),
                    "-01-01"
                )
            )
    )

    pub_date
}


#' Extract URLs in DO (INTERNAL)
#'
#' Extract URLs from the doid-edit.owl file of the Human Disease Ontology.
#'
#' @param doid_edit The contents of the doid-edit.owl file, as a character
#'     vector (as provided by [read_doid_edit()]).
#' @param include_obsolete Whether URLs associated with obsolete terms should
#'     be included, as a boolean (default: `FALSE`).
#' @param w_raw_match Whether to include the full line of doid-edit.owl where
#'     each URL was extracted from, as a boolean (default: `FALSE`).
#'
#' @return
#' A tibble of DOIDs and their associated URLs.
#'
#' @noRd
extract_doid_url <- function(doid_edit, include_obsolete = FALSE,
                             w_raw_match = FALSE) {
    doid_w_url <- doid_edit[has_doid_url(doid_edit)]

    df <- tibble::tibble(
        raw_match = doid_w_url,
        doid = stringr::str_extract(doid_w_url, "DOID[:_][0-9]+"),
        url_str = stringr::str_extract_all(doid_w_url, 'url:[^"]+"')
    )

    # tidy
    df <- df %>%
        tidyr::unnest_longer(.data$url_str) %>%
        dplyr::mutate(
            doid = stringr::str_replace(.data$doid, ".*DOID[_:]", "DOID:"),
            url = stringr::str_remove_all(.data$url_str, '^url:|"'),
            url_str = NULL
        )

    if (!isTRUE(include_obsolete)) {
        obs <- identify_obsolete(doid_edit)
        df <- dplyr::filter(df, !.data$doid %in% obs)
    }

    if (!isTRUE(w_raw_match)) {
        df <- dplyr::select(df, -.data$raw_match)
    }

    df
}


#' Extract Subtree
#'
#' Extracts the classes and parents of a DO subtree from a `pyDOID.owl.xml`
#' object.
#'
#' @inheritParams access_owl_xml
#' @param top_node The top node of the tree, as a valid DOID (see
#'     [is_valid_doid()] for valid input formats).
#' @param reload Force reload the file into memory, as `TRUE` or `FALSE`
#'     (default).
#'
#' @returns
#' A [tibble][tibble::tibble] with the columns: `id`, `label`, `parent_id`,
#' and `parent_label`, with one row for each unique combination for each
#' subclass below and including `top_node`.
#'
#' @export
extract_subtree <- function(x, top_node, reload = FALSE) {
    owl <- access_owl_xml(x)
    assert_string(top_node)

    top_class <- format_doid(top_node, as = "obo_CURIE")
    q <- glue::glue(subtree_query_glue)
    subtree <- owl$query(q, reload = reload) %>%
        tibble::as_tibble()

    subtree
}


#' Extract Class Axioms
#'
#' Extract `owl:equivalentClass` and `owl:subClassOf` axioms from the
#' doid-edit.owl file.
#'
#' @inheritParams read_doid_edit
#'
#' @returns
#' A list of two character vectors (`eq` and `subclass`) containing axioms in
#' OWL functional format.
#'
#' @family `extract_*_axiom` functions
#' @export
extract_class_axiom <- function(DO_repo) {
    doid_edit <- read_doid_edit(DO_repo)
    eq_raw <- grep("EquivalentClasses", doid_edit, value = TRUE)
    subclass_raw <- grep("SubClassOf.*Object", doid_edit, value = TRUE)
    list(eq = eq_raw, subclass = subclass_raw)
}


#' Extract Equivalent Class Axioms
#'
#' Extract `owl:equivalentClass` axioms from the doid-edit.owl file.
#'
#' @inheritParams read_doid_edit
#'
#' @returns
#' Equivalent class axioms in OWL functional format, as a character vector.
#'
#' @family `extract_*_axiom` functions
#' @export
extract_eq_axiom <- function(DO_repo) {
    doid_edit <- read_doid_edit(DO_repo)
    grep("EquivalentClasses", doid_edit, value = TRUE)
}


#' Extract 'Subclass Of' Axioms
#'
#' Extract `owl:subClassOf` axioms from the doid-edit.owl file.
#'
#' @inheritParams read_doid_edit
#'
#' @returns
#' 'Subclass Of' axioms in OWL functional format, as a character vector.
#'
#' @family `extract_*_axiom` functions
#' @export
extract_subclass_axiom <- function(DO_repo) {
    doid_edit <- read_doid_edit(DO_repo)
    grep("SubClassOf.*Object", doid_edit, value = TRUE)
}


#' Extract OWL/RDF as a tidygraph
#'
#' Extract 'nodes' and their 'parents' defined by a SPARQL `query` from OWL/RDF
#' as a tidygraph.
#'
#' @inheritParams access_owl_xml
#' @param query A SPARQL 1.1 query, as a string or the path to a .sparql/.rq
#'     file. If `NULL`, input is assumed to be an OBO Foundry ontology and the
#'     `oboInOwl:id` and `rdfs:label` of all OBO classes will be extracted. See
#'     "Query Requirements" section for more information.
#' @param collapse_method The method to use when collapsing extra data columns,
#'     as a string. See "Query Requirements" section for  more information.
#' @param debug _\[Intended for developers only\]_ Whether to debug execution.
#'     Returns all intermediate objects as part of output.
#'
#' @section Query Requirements:
#' [tidygraph][tidygraph::tidygraph-package] expects _unique_ child-parent
#' relationships, so at a minimum the SPARQL `query` should include `?id` (some
#' identifier for a 'child') and `?parent` (some identifier for each child's
#' parent(s)). All additional output variables specified in the SPARQL query
#' will be treated as 'node' annotations and collapsed using a method from
#' [collapse_col_flex()] to prevent duplication of records.
#'
#' @export
extract_as_tidygraph <- function(x, query = NULL, collapse_method = "first",
                                 debug = FALSE) {
    x <- access_owl_xml(x)
    if (debug) {
        info <- list(x = x)
        on.exit(return(x))
    }

    if (is.null(query)) {
        query <- "
            SELECT ?id ?label ?parent ?plabel
            WHERE {
                ?class a owl:Class ;
                    oboInOwl:id ?id ;
                    rdfs:label ?label ;
                    rdfs:subClassOf ?p_iri .

                ?p_iri oboInOwl:id ?parent ;
                    rdfs:label ?plabel .
            }"
    }
    if (debug) info["query"] <- query

    qres <- x$query(query) %>%
        tidy_sparql()
    qres <- collapse_col(
        qres,
        names(qres)[!names(qres) %in% c("id", "parent")],
        method = collapse_method
    )
    if (debug) info["query_res"] <- qres

    annotate <- dplyr::bind_rows(
        dplyr::select(qres, -dplyr::one_of("parent", "plabel")),
        dplyr::select(qres, "id" = "parent", "label" = "plabel")
    ) %>%
        dplyr::rename("name" = "id") %>%
        unique()
    if (debug) info["annotation_df"] <- annotate

    tg <- tidygraph::as_tbl_graph(
        dplyr::select(qres, "id", "parent")
    ) %>%
        tidygraph::activate("nodes") %>%
        dplyr::left_join(annotate, by = "name")
    if (debug) info["tidygraph"] <- tg

    tg
}
